# Image.
itcl::class Image {
	inherit Part

	public common eNumber "\[-\]?\[0-9.\]+"

	protected proc translatePt {pt tx ty} {list [expr [lindex $pt 0] + $tx] [expr [lindex $pt 1] + $ty]}
	protected proc scalePt {pt sx sy} {list [expr [lindex $pt 0] * $sx] [expr [lindex $pt 1] * $sy]}
	protected proc tiltLeftPt {pt bbox} {list [expr [lindex $bbox 1] + [lindex $bbox 3] - [lindex $pt 1]] [lindex $pt 0]}
	protected proc tiltRightPt {pt bbox} {list [lindex $pt 1] [expr [lindex $bbox 0] + [lindex $bbox 2] - [lindex $pt 0]]}
	protected proc mirrorXPt {pt bbox} {list [expr [expr [lindex $bbox 0] + [lindex $bbox 2]] - [lindex $pt 0]] [lindex $pt 1]}
	protected proc mirrorYPt {pt bbox} {list [lindex $pt 0] [expr [expr [lindex $bbox 1] + [lindex $bbox 3]] - [lindex $pt 1]]}

	protected proc scaleBBox {bbox scale} {list [Story::undouble [expr [lindex $bbox 0] * $scale]] [Story::undouble [expr [lindex $bbox 1] * $scale]] [Story::undouble [expr [lindex $bbox 2] * $scale]] [Story::undouble [expr [lindex $bbox 3] * $scale]]} 

	protected proc close {curves edgeBBox edgeMaxDist includeUpperLeftCorner}
	protected proc connect {curves}
	protected proc sideline {curves edgeBBox edgeMaxDist includeUpperLeftCorner}
	protected proc extend {curves edgeBBox edgeMaxDist}

	protected proc getSide {pt}
	protected proc getPoint {s}
	protected proc sideCompare {s1 s2}

	constructor {attributes} {Part::constructor $attributes} {}
	destructor {
		clearCurves
	}
	method copy {} {
		set duplicate [chain]
		$duplicate addCurves [getCurves]
		return $duplicate
	}
	method isEmpty {} {
		expr ![llength $iCurves] 
	}

	method getBBox {{rounded 0}} {
		unroundBBox [$iAttributes on bbox {}] $rounded
	}
	method setBBox {llx lly urx ury {rounded 0}} {
		if {$llx > $urx} {
			set t $llx
			set llx $urx
			set urx $t
		}
		if {$lly > $ury} {
			set t $lly
			set lly $ury
			set ury $t
		}
		$iAttributes set bbox [roundBBox "$llx $lly $urx $ury" $rounded]
	}
	method hasBBox {} {
		return [$iAttributes has bbox]
	}
	method getRounding {{rounded 0}} {
		if {$rounded} {return 1}
		return [$iAttributes on roundingScale 1]
	}
	method setRounding {roundingScale {overwrite 0}} {
		assert {$roundingScale > 0} {"Rounding factor should be strictly positive"}
		set scaleFactor [expr $overwrite ? $roundingScale / [$iAttributes on roundingScale 1] : $roundingScale]
		transform scalePt $scaleFactor $scaleFactor
		$iAttributes set roundingScale [expr $overwrite ? $roundingScale : $roundingScale * [$iAttributes on roundingScale 1]]
	}
	
	method getCurves {} {
		return $iCurves
	}
	method addCurves {curves} {
		foreach curve $curves {
			lappend iCurves [iarray::code [Curve #auto [$curve cget -iPoints] [$curve cget -iOperators]]]
		}
	}
	method clearCurves {} {
		foreach curve $iCurves {
			itcl::delete object $curve
		}
		set iCurves {}
	}

	method getPoints {{rounded 0}} {
		set points {}
		foreach curve $iCurves {
			foreach point [$curve getPoints] {
				lappend points [unroundPt $point $rounded]
			}
		}
		return $points
	}
	method isSameEndPoint {pt {rounded 0}} {
		if {[isEmpty]} {return 0}
		return [Curve::isSamePoint [[lindex $iCurves end] getEndPoint]  [roundPt $pt $rounded]]
	}
	method listLocations {{w 0} {h 0} {rounded 0}} {
		if {[$iAttributes on connected 0]} {return [getPoints $rounded]}
		set locations {}
		if {$w > 0 || $h > 0} {
			set hw [expr $w / 2.]
			set hh [expr $h / 2.]
			foreach curve $iCurves {
				set bbox [unroundBBox [$curve getBBox] $rounded]
				if {[Story::isEqual [expr [lindex $bbox 2] - [lindex $bbox 0]] $w] \
					&& [Story::isEqual [expr [lindex $bbox 3] - [lindex $bbox 1]] $h]} {
					lappend locations [list [expr [lindex $bbox 0] + $hw] \
						[expr [lindex $bbox 1] + $hh]]
				}
			}
		} else {
			foreach curve $iCurves {
				set bbox [unroundBBox [$curve getBBox] $rounded]
				set hw [expr ([lindex $bbox 2] - [lindex $bbox 0]) / 2.]
				set hh [expr ([lindex $bbox 3] - [lindex $bbox 1]) / 2.]
				lappend locations [list [expr [lindex $bbox 0] + $hw] \
					[expr [lindex $bbox 1] + $hh]]
			}
		}
		return $locations
	}

	method newPath {} {
		set iInCurve 0
	}
	method moveTo {pt {rounded 0}} {
		lappend iCurves [iarray::code [Curve #auto [roundPt $pt $rounded]]]
		set iInCurve 1
	}
	method lineTo {pt {rounded 0}} {
		assert {$iInCurve} {No moveto to start the curve}
		[lindex $iCurves end] lineTo [roundPt $pt $rounded]
	}
	method curveTo {pt1 pt2 pt {rounded 0}} {
		assert {$iInCurve} {No moveto to start the curve}
		[lindex $iCurves end] curveTo [roundPt $pt1 $rounded] [roundPt $pt2 $rounded] [roundPt $pt $rounded]
	}
	method arcTo {ptc r a1 a2 sgn {rounded 0}} {
		# Uses a formula by Aleksas Riskus, as demonstrated in Hans Muller's blog,
		# to convert an arc in a series of curves, each covering at most a 90 degrees arc.
		# To simplify things, each arc spans the same angle, so that the magic number k is
		# the same for every curve.
		# As such we can continue to consider any Curve object as a series of lines and curves,
		# without needing to force arcs in there. Arcs would have been problematic to do
		# transformations on (e.g. non-uniform scaling), as it would not have been enough to 
		# simply transform a number of control points.
		set a1 [expr $a1 - (int($a1) / 360) * 360]
		set a2 [expr $a2 - (int($a2) / 360) * 360]
		set ad [expr $a2 - $a1 + 360 * ($a2 == $a1 ? $sgn ? -1 : 1 : $a2 > $a1 ? $sgn ? -1 : 0 : $sgn ? 0 : 1)]
		set n [Story::roundUp [expr abs($ad)] 90]
		set ad [expr [Story::toRad $ad] / $n]
		set a [Story::toRad $a1]
		set ca [expr $r * cos($a)]
		set sa [expr $r * sin($a)]
		set k [expr 4. * (1 - cos($ad / 2.)) / sin($ad / 2.) / 3.]
		set pt [list [expr [lindex $ptc 0] + $ca] [expr [lindex $ptc 1] + $sa]]
		if {!$iInCurve} {
			lappend iCurves [iarray::code [Curve #auto [roundPt $pt $rounded]]]
		} elseif {![isSameEndPoint $pt]} {
			[lindex $iCurves end] lineTo [roundPt $pt $rounded]
		}
		for {set i 0} {$i < $n} {incr i} {
			set pt1 [list [expr [lindex $pt 0] - $sa * $k] [expr [lindex $pt 1] + $ca * $k]]
			set a [expr $a + $ad]
			set ca [expr $r * cos($a)]
			set sa [expr $r * sin($a)]
			set pt [list [expr [lindex $ptc 0] + $ca] [expr [lindex $ptc 1] + $sa]]
			set pt2 [list [expr [lindex $pt 0] + $sa * $k] [expr [lindex $pt 1] - $ca * $k]]
			[lindex $iCurves end] curveTo [roundPt $pt1 $rounded] [roundPt $pt2 $rounded] [roundPt $pt $rounded]
		}
		set iInCurve 1
	}
	method closePath {} {
		assert {$iInCurve} {No moveto to start the curve}
		set curve [lindex $iCurves end]
		if {![$curve isClosed]} {
			$curve lineTo [$curve getStartPoint]
		}
		set iInCurve 0
	}
	
	method transform {tfr args} {
		foreach curve $iCurves {
			eval [list $curve transformSelf $tfr] $args
		}
		if {[hasBBox]} {
			eval setBBox [eval [list $tfr [lrange [getBBox 1] 0 1]] $args] \
				[eval [list $tfr [lrange [getBBox 1] 2 3]] $args] 1
		}
	}
	method scale {sx sy} {
		transform scalePt $sx $sy
	}
	method translate {tx ty {rounded 0}} {
		set pt [list $tx $ty]
		eval transform translatePt [roundPt $pt $rounded]
	}
	method tiltLeft {} {
		assert {[hasBBox]} {BBox required}
		transform tiltLeftPt [getBBox 1]
	}
	method tiltRight {} {
		assert {[hasBBox]} {BBox required}
		transform tiltRightPt [getBBox 1]
	}
	method mirrorX {} {
		assert {[hasBBox]} {BBox required}
		transform mirrorXPt [getBBox 1]
	}
	method mirrorY {} {
		assert {[hasBBox]} {BBox required}
		transform mirrorYPt [getBBox 1]
	}
	method reverse {} {
		foreach curve $iCurves {
			$curve reverseSelf
		}
	}
	
	method closeEdge {maxDistToEdge includeUpperLeftCorner {rounded 0}} {
		assert {[hasBBox]} {BBox required}

		set allCurves [close $iCurves \
			[getBBox 1] [expr $maxDistToEdge * [getRounding $rounded]] $includeUpperLeftCorner]
	
		set looseCurves [lindex [lindex $allCurves 1] 1]
		if {[llength $looseCurves] > 0} {
			inform "Discarding [llength $looseCurves] loose curves"
			foreach curve $looseCurves {
				inform "From [unroundPt [$curve getStartPoint] $rounded] to [unroundPt [$curve getEndPoint] $rounded]"
				itcl::delete object $curve
			} 
		}
		set iCurves [concat [lindex [lindex $allCurves 1] 0] [lindex $allCurves 0]]
	}

	protected method doPrune {variablesPtr} {
		upvar $variablesPtr variables
		if [$iAttributes has bbox] {
			detect [$iAttributes of bbox] variables
		}
		if [$iTributes has operator] {
			detect [$iTributes of operator] variables
		}
	}

	protected method doRead {I} {
		$I expect line "^\\\{$" {
			$I continue
		}"^($eNumber $eNumber) m$" {
			eval moveto [$I get match 1] 1
			$I continue
		} "^($eNumber $eNumber) l$" {
			eval lineto [$I get match 1] 1
			$I continue
		} "^($eNumber $eNumber $eNumber $eNumber $eNumber $eNumber) c$" {
			eval curveto [$I get match 1] 1
			$I continue
		} "^(\\\})?[$iTributes on operator {}]$" {
			$I continue
		} 
	}

	protected method doWrite {U} {
		set operator [$iTributes on operator ""]
		set isExecutable [$iTributes on isExecutable 0]
		foreach curve $iCurves {
			if {$isExecutable} {
				$U write line "\{"
				$U indent
			}
			$U write line "[lapply [$curve getStartPoint] Story::dedouble] m"
			$curve forEachPiece piece {
				$U write line "[lapply $piece Story::dedouble] l"
			} {
				$U write line "[lapply [eval concat $piece] Story::dedouble] c"
			}
			if {$isExecutable} {
				$U deindent
				$U write line [string trim "\} $operator"]
			} elseif {[string length $operator]} {
				$U write line $operator
			}
		}
	}
	
	protected method roundPt {pt rounded} {
		if {!$rounded && [$iAttributes has roundingScale]} {
			set roundingScale [$iAttributes of roundingScale]
			scalePt $pt $roundingScale $roundingScale
		} else {
			return $pt
		}
	}
	protected method unroundPt {pt rounded} {
		if {!$rounded && [$iAttributes has roundingScale]} {
			set roundingScale [expr 1. / [$iAttributes of roundingScale]]
			scalePt $pt $roundingScale $roundingScale
		} else {
			return $pt
		}
	}
	protected method roundBBox {bbox rounded} {
		if {!$rounded && [llength $bbox] && [$iAttributes has roundingScale]} {
			scaleBBox $bbox [$iAttributes of roundingScale]
		} else {
			return $bbox
		}
	}
	protected method unroundBBox {bbox rounded} {
		if {!$rounded && [llength $bbox] && [$iAttributes has roundingScale]} {
			scaleBBox $bbox [expr 1. / [$iAttributes of roundingScale]]
		} else {
			return $bbox
		}
	}
	
	variable iCurves {}
	variable iInCurve 0
}

itcl::body Image::close {curves edgeBBox edgeMaxDist includeUpperLeftCorner} {
	set openCurves {}
	set closedCurves {}
	foreach curve $curves {
		if {[$curve isClosed]} {
			lappend closedCurves $curve
		} else {
			lappend openCurves $curve
		}
	}

	# First portion are original curves, second portion is newly created.
	list $closedCurves [sideline $openCurves $edgeBBox $edgeMaxDist $includeUpperLeftCorner]
}

itcl::body Image::connect {curves} {
	set connectedCurves {}
	foreach curve $curves {
		set start [$curve getStartPoint]
		set end [$curve getEndPoint]
		set idx -1
		set connectedIdx -1
		foreach connectedCurve $connectedCurves {
			incr connectedIdx
			if [$connectedCurve connectSelf $curve] {
				if {$idx > -1} {
					itcl::delete object $curve
					set connectedCurves [lreplace $connectedCurves $idx $idx]
					incr connectedIdx -1
				}
				set curve $connectedCurve
				set idx $connectedIdx
			}
		}
		if {$idx == -1} {
			lappend connectedCurves [Curve #auto [$curve cget -iPoints] [$curve cget -iOperators]]
		}
	}
	return $connectedCurves
}

itcl::body Image::sideline {curves edgeBBox edgeMaxDist includeUpperLeftCorner} {
	set connectedCurves [connect $curves] 

	set sidePoints {}
	set looseCurves {}
	set edgeCurves {}
	foreach curve $connectedCurves {
		set startSidePoint [getSide [$curve getStartPoint]]
		set endSidePoint [getSide [$curve getEndPoint]]
		if {([llength $startSidePoint] == 0) || ([llength $endSidePoint] == 0)} {
			lappend looseCurves $curve
		} else {
			lappend edgeCurves $curve
			lappend sidePoints [lappend startSidePoint $curve 0] [lappend endSidePoint $curve 1]
		}
	}


	set sidePoints [lsort -command sideCompare $sidePoints]
	set edging $includeUpperLeftCorner
	if {$edging} {
		set leadCurve [Curve #auto "[lindex $edgeBBox 0] [lindex $edgeBBox 3]"]
		set leadSidePoint "0 0 0"
		lappend sidePoints [list 3 [expr [lindex $edgeBBox 3] - [lindex $edgeBBox 1]] 0 $leadCurve 1]
		lappend edgeCurves $leadCurve
	}

	foreach sidePoint $sidePoints {
		if {$edging} {
			if {[lindex $leadSidePoint 2] != 0} {
				set leadSidePoint [list [lindex $leadSidePoint 0] [lindex $leadSidePoint 1] 0]
				$leadCurve lineTo [getPoint $leadSidePoint]
			}
			while {[lindex $leadSidePoint 0] < [lindex $sidePoint 0]} {
				set leadSidePoint [list [expr [lindex $leadSidePoint 0] + 1] 0 0]
				$leadCurve lineTo [getPoint $leadSidePoint]
			}
			if {[lindex $leadSidePoint 1] < [lindex $sidePoint 1]} {
				set leadSidePoint [list [lindex $sidePoint 0] [lindex $sidePoint 1] 0]
				$leadCurve lineTo [getPoint $leadSidePoint]
			}
			if {[lindex $sidePoint 2] != 0} {
				$leadCurve lineTo [getPoint $sidePoint]
			}
			set edging 0
		} else {
			set leadSidePoint [lrange $sidePoint 0 2]
			set leadCurve [lindex $sidePoint 3]
			if {[lindex $sidePoint 4] == 0} {$leadCurve reverseSelf}
			set edging 1
		}
	}

	set connectedEdgeCurves [connect $edgeCurves]
	foreach curve $edgeCurves {itcl::delete object $curve}
	list $connectedEdgeCurves $looseCurves
}

itcl::body Image::extend {curves edgeBBox edgeMaxDist} {
	foreach curve $curves {
		set startSidePoint [getSide [$curve getStartPoint]]
		if {([llength $startSidePoint] > 0) && ([lindex $startSidePoint 2] > 0)} {
			$curve reverseSelf
			$curve lineTo [getPoint [lreplace $startSidePoint 2 2 0]]
			$curve reverseSelf
		}
		set endSidePoint [getSide [$curve getEndPoint]]
		if {([llength $endSidePoint] > 0) && ([lindex $endSidePoint 2] > 0)} {
			$curve lineTo [getPoint [lreplace $endSidePoint 2 2 0]]
		}
	}
}

itcl::body Image::getSide {pt} {
	upvar edgeBBox edgeBBox
	upvar edgeMaxDist edgeMaxDist
	set dist [expr [lindex $edgeBBox 3] - [lindex $pt 1]]
	if {$dist < $edgeMaxDist} {return [list 0 [expr [lindex $pt 0] - [lindex $edgeBBox 0]] $dist]}
	set dist [expr [lindex $edgeBBox 2] - [lindex $pt 0]]
	if {$dist < $edgeMaxDist} {return [list 1 [expr [lindex $edgeBBox 3] - [lindex $pt 1]] $dist]}
	set dist [expr  [lindex $pt 1] - [lindex $edgeBBox 1]]
	if {$dist < $edgeMaxDist} {return [list 2 [expr [lindex $edgeBBox 2] - [lindex $pt 0]] $dist]}
	set dist [expr [lindex $pt 0] - [lindex $edgeBBox 0]]
	if {$dist < $edgeMaxDist} {return [list 3 [expr [lindex $pt 1] - [lindex $edgeBBox 1]] $dist]}
	return {}
}

itcl::body Image::getPoint {s} {
	upvar edgeBBox edgeBBox
	switch [lindex $s 0] 0 {
		return [list [expr [lindex $edgeBBox 0] + [lindex $s 1]] [expr [lindex $edgeBBox 3] - [lindex $s 2]]]
	} 1 {
		return [list [expr [lindex $edgeBBox 2] - [lindex $s 2]] [expr [lindex $edgeBBox 3] - [lindex $s 1]]]
	} 2 {
		return [list [expr [lindex $edgeBBox 2] - [lindex $s 1]] [expr [lindex $edgeBBox 1] + [lindex $s 2]]]
	} 3 {
		return [list [expr [lindex $edgeBBox 0] + [lindex $s 2]] [expr [lindex $edgeBBox 1] + [lindex $s 1]]]
	}
}

itcl::body Image::sideCompare {s1 s2} {
	set diff [expr [lindex $s1 0] - [lindex $s2 0]]
	if {$diff != 0} {return $diff}
	set diff [expr [lindex $s1 1] - [lindex $s2 1]]
	if {$diff != 0} {return $diff}
	expr [lindex $s1 2] - [lindex $s2 2]
}
